64'er 1989 July/64er_Magazin_89-07_1989_Markt__Technik_de_Side_A.d64/declare 88 src

Commodore BASIC | 2022-10-26 | 22KB | 590 lines

0 poke53280,11:poke53281,15:printchr$(144):end
10 sys9*4096:.opt oo:*=$c000
20 ; *** programmteiladressen ***
29 prg0a = $7300:prg0e = $73ff
30 prg1a = $c000:prg1e = $c3ff
34 prg3a = $8000:prg3e = $83ff
35 prg4a = $d400:prg4e = $d7ff
150 lo = 167:hi = 168:lo2 = 169:hi2 = 170
155 strpt = 178;179:counter = 180;181
156 startadr = 250
160 data = $83:rem = $8f:print = $99
180 pnt2 = $49:charout = $ab47
200 char = 8:count = 11:pnt = $71
230 quote = $22:flag = 15:txtptr = $7a
260 buffer = $200:table = $a09e
265 ready = $a474:ckcom = $aefd
270 speicher = $7000:cassette = 828
301 ; neue commands
303 cmdstart = $cc:cmdlast = $d1:funend = $ff
375 ; *********************
376 ; *** programmteil1 ***
378 ; *** interpreter neu ***
440 tokenread ldx txtptr:ldy #4:sty flag
450 jsr down:jsr nextchar:pha:jsr up:pla:jmp $a609
570 ; fuer vergleich mit table auftauchen
580 l575 jsr up:jsr compare:jmp down; back to nextchar
2000 ; *** neue list-routine ***
2030 tokenlist bpl out
2033 bit flag:bmi out;quot-modus
2035 cmp #$ff:beq out
2040 cmp #$cc:bcs newlist
2050 jmp $a724:out jmp $a6f3
2055 newlist cmp cmdend:bcc l2060
2058 sbc funstart:clc:adc cmdend
2060 l2060 sec:sbc #$cb:tax:sty pnt2
2065 lda #<(newtab-1):sta lo:lda #>(newtab-1):sta hi:ldy #0:beq l2085
2080 loop iny:bne l2080:inc hi:l2080 lda (lo),y:bpl loop
2085 l2085 dex:bne loop
2090 found iny:bne l2095:inc hi
2095 l2095 lda (lo),y:bmi oldend:jsr charout:bne found
2100 oldend jmp $a6ef
3000 ; *** commands ausfuehren ***
3020 typflag = 13:chrget = $73:chr(NULL)t = chrget+6
3030 execold = $a7ed:inter = $a7ae:funktold = $ae8d
3040 getterm = $aef1:checknum = $ad8d
3050 ; *** procedures ***
3110 newcmd jsr chrget:jsr testcmd:jmp inter
3120 testcmd cmp #cmdstart:bcc oldcmd:cmp cmdend:bcc cmd2
3130 oldcmd jsr chr(NULL)t:jmp execold
3140 cmd2 sec:sbc #cmdstart:asl:tay
3145 lda #<cmdtab:sta lo:lda #>cmdtab:sta hi
3150 iny:lda (lo),y:dey:pha:lda (lo),y:pha:jmp chrget
3155 ; *** functions ***
3160 newfun lda #0:sta typflag:jsr chrget:cmp funstart:bcc oldfun
3170 cmp #funend:bcc fun2
3180 oldfun jsr chr(NULL)t:jmp funktold
3190 fun2 sec:sbc funstart:asl:clc:adc funtabanf:sta jumpind+1
3192 lda funtabanf+1:adc #0:sta jumpind+2
3194 jsr chrget:jsr getterm:jsr jumpind:jmp checknum
3210 jumpind jmp ($ffff)
3300 ; *****************************
3302 ; *** procedure deklarieren ***
3312 procedure lda #1:jsr declare
3314 proc2 inc cmdend
3320 lda funstranf:clc:adc strlen:sta funstranf:bcc l3338:inc funstranf+1
3338 l3338 lda funtabanf:clc:adc #2:sta funtabanf:bcc l3342:inc funtabanf+1
3342 l3342 rts
3400 ; ****************************
3402 ; *** funktion deklarieren ***
3411 function lda #0:jsr declare
3420 funct2 dec funstart:rts
3510 ; ******************************
3511 ; ** fun/proc/pack name lesen **
3520 title jsr strevl:sta titlen:sty titpoint+1:stx titpoint
3525 jsr $e200:stx device:lda #0:sta adressen:rts
3530 ; ******************************
3531 ; test, ob cmd dekl. werden kann
3532 ; name im buffer
3535 dekltest jsr compare:bne error19; redefinition
3540 ; testen, ob nummer frei
3542 lda funstart:cmp cmdend:beq error16:rts
3550 error16 ldx #16; out of (NULL) :.byte $2c
3552 error19 ldx #19:jmp error; redim error
3598 ; ********************************
3599 ; ** proc/fun laden/assemblieren *
3600 declare sta type:jsr title:jsr dekltest
3601 jsr vorb; ckcom/opfile
3615 jsr inpstring;down
3630 jsr decl2; header und prgteil
3693 ; ** command (title) einbauen
3695 lda titpoint:sta strpt:lda titpoint+1:sta strpt+1
3698 lda titlen:sta strlen:jsr einbauen:jmp up
3700 ; ********************************
3701 ; ** zeichenkette nach (strpt)  **
3703 ; **   ende mit doppelpunkt    **
3704 ; ** kehrt in down-mode zurueck **
3710 inpstring jsr up:lda device:bne l3716
3712 jsr strevl:jmp down; device 0
3716 l3716 lda commend:sta strpt:lda commend+1:sta strpt+1:ldy #0
3718 ; *** header muss geholt werden
3720 l3720 lda device:cmp #1:beq l3725
3721 ; *** .asc von disk  **
3722 jsr $e112:bit 144:bvc l3728
3723 l3723 ldx #11:jmp error; syntax
3724 ; *** .asc im speicher abgelegt **
3725 l3725 lda (startadr),y
3728 l3728 sta (strpt),y:iny:beq l3723:cmp #":":bne l3720
3730 tya:sta strlen
3732 l3732 clc:adc startadr:sta startadr:bcc l3734:inc startadr+1
3734 l3734 jmp down
3777 ; ********************************
3778 ; * string auswerten, strpt setzen
3780 strevl jsr $ad9e:jsr $b6a3:sta strlen:sty strpt+1:stx strpt:rts
4000 ; ************************
4001 ; *** pack deklarieren ***
4012 pack jsr title:lda commend:sta prganf:lda commend+1:sta prganf+1
4035 lda #2:sta type:jsr vorb; ckcom/opfile
4105 jsr inpstring;down
4110 jsr pac2; header,prgteil holen:jmp up
4160 ; ** aus pac2 fuer dekltest auftauchen
4165 l4165 jsr up:jsr dekltest:jmp down; back nach pac2
4200 ; *****************************
4201 ; ** header-read vorbereiten **
4202 vorb lda device:beq l4218
4204 cmp #8:beq l4214
4206 ; *** device 1, aus speicher - startadr holen
4208 jsr ckcom:jsr $ad8a:jsr $bc9b
4210 lda $65:sta startadr:lda $64:sta startadr+1:rts
4212 ; ** nur device 8
4214 l4214 jmp opfile;rts
4216 ; ** nur device 0
4218 l4218 jmp ckcom;rts
4300 ; ******************************
4301 ; * up,programmteil holen,down *
4310 inprg jsr up:lda device:beq l4316:cmp #1:beq l4320
4313 ; ** nur device 8
4314 jmp infile;load,down,anpassen
4315 ; ** nur device 0
4316 l4316 jmp asmprg; assemblieren,down
4318 ; *** nur device 1 - nach commend kopieren ,down, anpassen
4320 l4320 ldy #0:lda (startadr),y:sta endadr:iny:lda (startadr),y:sta endadr+1
4322 lda #2:jsr l3732; startadresse+accu, down
4326 ; *** 4328-4336 down-mode ***
4328 l4328 lda commend:sta lo:lda commend+1:sta hi
4329 lda startadr:sta lo2:lda startadr+1:sta hi2:ldy #0
4330 l4330 lda (lo2),y:sta (lo),y
4332 inc lo2:bne l4333:inc hi2
4333 l4333 inc lo:bne l4334:inc hi
4334 l4334 sec:lda lo2:sbc endadr:lda hi2:sbc endadr+1:bcc l4330
4336 jmp adranp
5101 ; ********************************
5102 ; string (strpt) mit tables vergl.
5103 ;ergebnis a>0 count-nr des tokens
5104 ;        a=0 token nicht definiert
5110 ; *** mit rom-table ***
5120 compare lda #0:sta count
5122 lda #>table:sta hi:lda #<table:sta lo:jsr compsub:bne l5274
5130 ; *** mit newtab ***
5140 compare2 lda #>newtab:sta hi:lda #<newtab:sta lo
5142 lda #cmdstart:sta count
5220 ; ********************************
5222 ; ** mit table (lo/hi) vergleichen
5230 compsub lda #0:sta complen
5245 l5245 ldy #0
5248 l5248 lda (strpt),y:sec:sbc (lo),y:iny:and #$ff:beq l5248
5250 cmp #$80:beq l5270
5251 inc count:dey:dey
5252 l5252 iny:lda (lo),y:bpl l5252:iny:lda (lo),y:beq l5272
5255 tya:clc:adc lo:sta lo:bcc l5245:inc hi:bne l5245
5270 l5270 ora count:sty complen
5272 l5272 sta count
5274 l5274 rts
5500 ; ********************
5501 ; *** memory-dump  ***
5504 memory lda #<newtab:sta lo:lda #>newtab:sta hi:ldy #0
5506 l5506 lda (lo),y:beq l5520:bpl l5512
5510 l5510 and #127:jsr $f1ca:lda #13
5512 l5512 jsr $f1ca:iny:bne l5506:inc hi:bne l5506
5518 ; *** anfang und ende des procedurespeichers ***
5520 l5520 lda commands+1:ldx commands:jsr $bdcd
5522 lda #"-":jsr $f1ca
5524 lda commend+1:ldx commend:jmp $bdcd
5600 ; *******************************
5601 ; *** ascii-zahl im buffer -> int
5602 ; *** aus down, ende mit down
5604 buffint jsr up:lda $7a:pha:lda $7b:pha
5606 lda strpt+1:sta $7b:lda strpt:sta $7a:jsr $0079:jsr $bcf3:jsr $bc9b
5608 lda $7a:sta strpt:lda $7b:sta strpt+1
5610 pla:sta $7b:pla:sta $7a:jmp down
6200 ; ********************************
6201 ; ** programmteil von disk lesen *
6202 ; ** und adressen anpassen       *
6216 infile lda commend:sta lo:lda commend+1:sta hi
6220 basin jsr $ffcf:ldy #0:sta (lo),y
6224 inc lo:bne l6226:inc hi
6226 l6226 bit 144:bvc basin
6240 ; *** file schliessen ***
6244 l6244 jsr close:jsr down:jmp adranp
6300 ; ***************************
6301 ; *** object file oeffnen ***
6302 ; filename komplettieren
6303 opfile lda #1:jsr $ffc3;file1 schliessen
6304 lda #1:ldx device:ldy #2:jsr $ffba:ldy #0:ldx #0
6306 l6306 lda (strpt),y:sta cassette,y:iny:cpy strlen:bne l6306
6308 l6308 lda type:cmp #2:beq l6312
6309 ; *** name.obj ***
6310 lda objstr,x:bne l6314
6311 ; *** name.pac ***
6312 l6312 lda pacstr,x
6314 l6314 sta cassette,y:iny:inx:cpx #4:bne l6308
6315 ; ** file open **
6316 l6316 tya:ldx #<cassette:ldy #>cassette:jsr $ffbd:jsr $ffc0
6320 ; ** error control #2,8,15 **
6322 lda #2:ldx device:ldy #15:jsr $ffba
6324 lda #0:jsr $ffbd:jsr $ffc0:ldx #2:jsr $ffc6
6326 jsr $ffcf:cmp #48:beq l6328:ldx #4:jmp error; file not found
6328 l6328 jsr $ffcc:ldx #1:jsr $ffc6; file1
6330 jsr $ffcf:sta startadr:jsr $ffcf:sta startadr+1:rts
6410 ; *************************
6411 ; *** close files #1,#2 ***
6412 close jsr $ffcc:lda #1:jsr $ffc3:lda #2:jsr $ffc3:jmp $fd15
6420 ; *****************************
6422 ; *** error aus ram ebene 2 ***
6424 error jsr up:txa:pha:jsr close:pla:tax:jmp $a43a
6500 ; *****************************
6501 ; *** system initialisieren ***
6510 init jsr down:jmp l16504
6600 ; *****************************
6601 ; *** speicherkonfiguration ***
6610 down sei:lda 1:and #248:sta 1:rts
6612 up lda 1:ora #7:sta 1:cli:rts
7450 ; *****************************
7451 ; *** programm assemblieren ***
7452 ; startadresse hinterlegen
7454 asmprg tsx:stx var:jsr down:jsr l16304
7460 jmp $9000
7461 ; assembler normalisieren
7462 back jsr down:jsr l16312
7469 ; wieder in asm springen
7470 jsr $9ddb:tsx:cpx var:bne l7472:jmp down; rts
7472 l7472 jmp ready
7500 ; ** leerbytes bis variablenanf.
9000 ; ************************
9001 ; *** variablenbereich ***
9002 *=$c480 ; 48 bytes - $c4b0
9020 type .byte $ff
9025 commands .word speicher:commend .word speicher
9304 cmdend .byte cmdlast; +5 (proc+fun+in+mem+pac)
9305 funstart .byte funend
9307 funstranf .word funstrtab
9308 funstrend .word funstrtab
9310 funtabanf .word funtab
9312 funtabend .word funtab
9315 endadr .word 00   ; altes programm
9317 prganf .word 00   ; des neuen
9318 prgend .word 00   ; programms
9368 titpoint .word 00:titlen .byte 0
9369 strlen .byte 0
9371 complen .byte 0:insanf .word 00
9372 adressen .byte 00:usadr .word 00
9373 device .byte 00:var .byte 00
9375 objstr .asc ".obj"
9376 pacstr .asc ".pac"
10000 ; *********************
10001 ; *** programmteil2 ***
10002 ; *********************
10100 *=$8000
10350 ; ***************************
10352 ; *** interpreter part ii ***
10380 nextchar lda buffer,x:bpl normal:inx:cmp #$ff:bne nextchar:dex
10410 ; * alle zeichen <128 und $ff=(NULL) *
10440 normal bit flag:bvs takchar;datazeile
10490 cmp #"?":beq chr63
10560 ; *** auf tokens testen ***
10570 checktoken sty pnt:stx txtptr
10575 stx strpt:lda #2:sta strpt+1:jsr l575; comp mit tables
10576 lda complen:clc:adc txtptr:tax:ldy pnt
10580 lda count:beq notfound:dex:cmp cmdend:bcc takchar
10585 sec:sbc cmdend:clc:adc funstart:bne takchar
10590 ; *******************
10710 chr63 lda #print:bne takchar
10715 ; *******************
10720 notfound lda buffer,x
10730 ; *** zeichen uebernehmen ***
10731 ; und auf ":",data,rem testen
10740 takchar inx:iny:sta buffer-5,y
10760 cmp #0:beq ende; * zeilenende *
10770 ; ** test auf hochkomma **
10771 cmp #quote:beq chr34
10780 ; ** test auf ":" **
10781 cmp #":":bne l10791:lda #0:sta flag
10790 ; ** test auf data **
10791 l10791 cmp #data:bne l10801:lda #64:sta flag
10800 ; ** test auf rem **
10801 l10801 cmp #rem:bne nextchar
10810 ; ******************
10845 chr34 sta char
10850 ; *** text uebernehmen ***
10860 copytext lda buffer,x:iny:inx:sta buffer-5,y
10870 cmp char:beq nextchar:cmp #0:bne copytext
10875 ende rts; zeilenende
12900 ; *********************
12901 ; ** file bearbeiten **
12910 l12910 ldx #11:jmp error; syntax
12920 ; *** header lesen ***
12921 ; *** "nur bei pack:"
12922 ; ** "procedure oder function"
12975 pac2 jsr compare2:sec:sbc #cmdstart:cmp #2:bcs l12910
12990 eor #1:sta type:lda complen:jsr addstrp:jsr nextchr:cpx #32:bne l12910
13004 jsr l4165; dekltest up:ldy #$ff
13010 ; *** strlen bestimmen ***
13012 l13012 iny:lda (strpt),y:beq l12910:cmp #quote:beq l12910
13014 cmp #",":beq l13020:cmp #":":bne l13012
13020 l13020 sty strlen:jsr einbauen:lda strlen:jsr addstrp
13030 lda type:beq l13030:jsr proc2:bne l13040:l13030 jsr funct2
13040 l13040 lda prganf:clc:adc #3:sta prganf:bcc l13045:inc prganf+1
13045 l13045 jsr nextchr:cpx #",":beq pac2:cpx #":":bne l12910
13060 lda device:beq decl2:jsr inpstring
13100 ; *************************
13102 ; * 'program' oder 'using'
13104 ; * "pack" und solo-deklarationen
13108 decl2 jsr txvergl; x 0=us,1=prg:txa:bne l13210
13110 jsr nextchr:cpx #32:bne l13452
13115 ; ** using-statement bearbeiten
13120 l13120 jsr compare2:beq l13450
13124 lda complen:jsr addstrp
13126 jsr nextchr:cpx #",":bne l13452
13128 jsr usingadr:jsr buffint
13135 lda usadr:clc:adc $65:pha:lda usadr+1:adc $64:pha:inc adressen
13140 jsr nextchr:cpx #",":beq l13120:cpx #":":bne l13452; syntax
13142 lda device:beq l13144:jsr inpstring
13143 ; ** header-test auf "program:"
13144 l13144 jsr txvergl:txa:beq l13452
13200 ; ** "program:" -> prgteil laden
13210 l13210 jsr nextchr:cpx #":":bne l13452
13212 lda commend:sta prganf:lda commend+1:sta prganf+1:jsr inprg
13220 ; * ggf. using-adressen einsetzen
13221 ; * usingausw nicht mit jsr
13226 lda adressen:beq l13230:jmp usingausw; mit jmp zurueck
13228 ; ** commands-ende setzen
13230 l13230 lda prgend:sta commend:lda prgend+1:sta commend+1:rts
13430 ; *********************
13431 ; ** fehlermeldungen **
13450 l13450 ldx #17:.byte $2c; undef'd statement
13452 l13452 ldx #11:jmp error; syntax
13500 ; *******************************
13501 ; * (strpt) mit 'using','program'
13502 ; * vergl. x -> 0=using,1=program
13510 txvergl lda #>ustab:sta hi:lda #<ustab:sta lo:lda #0:sta count
13520 jsr compsub:beq l13452
13524 and #1:tax:lda complen:bne addstrp;rts
13600 ; ******************************
13601 ; * next char bei (strpt) -> x *
13602 ; * und strpt increment
13605 nextchr ldy #0:lda (strpt),y:tax:lda #1
13608 ; *** akku zu strpt addieren **
13610 addstrp clc:adc strpt:sta strpt:bcc l13612:inc strpt+1
13612 l13612 rts
13708 ; ****************************
13709 ; * commamd (strp) einbauen **
13710 ; * stringtabelle schieben
13711 ; * funstrend + len
13712 einbauen ldx strlen:lda funstranf:sta insanf:lda funstranf+1:sta insanf+1
13714 lda funstrend:sta lo:clc:adc strlen:sta funstrend
13716 lda funstrend+1:sta hi:adc #0:sta funstrend+1:jsr insert
13720 ; *** string in newtab ***
13721 ldy #0
13722 l13722 lda (strpt),y:sta (lo),y:iny:cpy strlen:bne l13722
13724 dey:lda (lo),y:ora #$80:sta (lo),y
13738 ; * adressentabelle schieben
13739 ; * funtabend + 2
13740 ldx #2:lda funtabanf:sta insanf:lda funtabanf+1:sta insanf+1
13742 lda funtabend:sta lo:clc:adc #2:sta funtabend
13750 lda funtabend+1:sta hi:adc #0:sta funtabend+1:jsr insert
13778 ; *** anf.adr in tabelle ***
13779 ; *** procs    adr=anf-1 ***
13780 ldy #0:sec:lda prganf:sbc type:sta (lo),y:iny
13784 lda prganf+1:sbc #0:sta (lo),y:rts
14725 ; *******************************
14732 ; ** using-adresse nach usadr  **
14733 ; in count using-token-nr
14740 usingadr lda count:sbc #cmdstart:asl a:tay
14742 lda cmdend:clc:sbc count
14750 ; proc -> carry set -> adresse+1
14752 ; func -> carry clr -> adresse+0
14770 ; * tab-adresse +carry -> usadr *
14772 lda #<cmdtab:sta lo:lda #>cmdtab:sta hi
14773 lda (lo),y:adc #0:sta usadr
14774 iny:lda (lo),y:adc #0:sta usadr+1:rts
14800 ; *****************************
14801 ; * programmteil von disk     *
14802 ; * teil2 - adressen anpassen *
14845 adranp lda commend:sta counter:lda commend+1:sta counter+1
14850 ; ** prglen (a/y)= hi/lo-prganf
14852 lda lo:sta prgend:sec:sbc prganf:tax;prglen-lo
14854 lda hi:sta prgend+1:sbc prganf+1:tay;prglen-hi
14860 ; ** endadr=startadr+prglen (a/y)
14862 txa:clc:adc startadr:sta endadr
14864 tya:adc startadr+1:sta endadr+1
14900 ; *******************************
14902 ; ** absolute adressen suchen ***
14903 ; ** bis unbrauchbares zeichen **
14904 ; ** z.b. $ff **
14910 adapt ldy #0:lda (counter),y:cmp #$ff:beq l4924:tax:dey
14911 l14911 iny:txa:and masktab,y:cmp bittab,y:bne l14911
14914 lda lentab,y:cmp #3:bne l4918:pha:jsr absolut:pla
14918 l4918 clc:adc counter:sta counter:bcc l4920:inc counter+1
14920 l4920 sec:sbc prgend:lda counter+1:sbc prgend+1:bcc adapt
14924 l4924 rts
14950 ; *** absolute adr < startadresse
14954 absolut ldy #1:sec:lda (counter),y:sbc startadr
14956 iny:lda (counter),y:sbc startadr+1:bcc l4988
14965 ; *** abs.adr > endadresse
14970 ldy #1:sec:lda endadr:sbc (counter),y
14972 iny:lda endadr+1:sbc (counter),y:bcc l4988
14980 ; *** abs.adr. anpassen ***
14982 l4982 ldy #1:lda (counter),y:sec:sbc startadr:tax; lo
14984 iny:lda (counter),y:sbc startadr+1:pha; hi
14986 dey:txa:clc:adc prganf:sta (counter),y
14988 iny:pla:adc prganf+1:sta (counter),y:l4988 rts
14995 ; *****************************
14996 ; **  using-plaetze suchen    *
14997 ; ** adressen aus stack holen *
15001 ; **  und einsetzen           *
15002 usingausw tsx:txa:clc:adc adressen:adc adressen:tax:txs
15004 lda prganf:sta counter:lda prganf+1:sta counter+1
15005 l15005 ldy #0:lda (counter),y:iny:and (counter),y:cmp #$ff:beq adrein
15008 inc counter:bne l15010:inc counter+1
15010 l15010 sec:lda counter:sbc prgend:lda counter+1:sbc prgend+1:bcc l15005
15015 ; ** kein platz fuer using-adr **
15020 ldx #13:jmp error; out of data error
15028 ; ** adr aus stack-bereich holen
15030 adrein lda $0100,x:dey:sta (counter),y
15032 iny:dex:lda $0100,x:sta (counter),y:dex
15034 dec adressen:bne l15005:jmp l13230; praktisch rts
15600 ; *** platz schaffen ***
15601 ; ** im x-reg anzahl ***
15602 ; ** von insanf bis lo/hi **
15603 insert stx var
15605 l5605 ldy #0:lda (lo),y:ldy var:sta (lo),y
15610 sec:lda insanf:sbc lo:lda insanf+1:sbc hi:bcs l5620
15615 dec lo:lda lo:cmp #$ff:bne l5605:dec hi:bne l5605
15620 l5620 rts
16500 ; *****************************
16501 ; *** system initialisieren ***
16504 l16504 lda #cmdlast:sta cmdend:lda #funend:sta funstart
16506 lda #<funstrtab:sta funstranf:sta funstrend
16507 lda #>funstrtab:sta funstranf+1:sta funstrend+1
16510 lda #<funtab:sta funtabanf:sta funtabend
16511 lda #>funtab:sta funtabanf+1:sta funtabend+1
16515 lda commands:sta commend:lda commands+1:sta commend+1
16518 lda #0:sta funtab:sta funtab+1:sta funstrtab:sta funstrtab+1:jmp up
17050 ; *** disass-daten ***
17051 ; bytes pro befehl $00 - $ff
17052 .byte $ff
17060 masktab .byte %00001100;$xc,xd,xe,xf
17061 .byte %11111111;$20
17062 .byte %10011111;$00,40,60
17063 .byte %00001000;$x0-x7
17064 .byte %00001101;$x8,xa
17065 .byte %00011101;hi 2x+lo 9,b
17066 .byte %11011111;$9b,bb
17067 .byte %00011101;hi(2x+1)+lo 9,b
17070 bittab .byte %00001100
17071 .byte %00100000
17072 .byte %00000000
17073 .byte %00000000
17074 .byte %00001000
17075 .byte %00001001
17076 .byte %10011011
17077 .byte %00011001
17080 lentab .byte 3,3,1,2,1,2,1,3
18300 ; *****************************
18301 ; *** programm assemblieren ***
18302 ; startadresse hinterlegen
18304 l16304 lda commend:sta $902e:lda commend+1:sta $9032
18307 ; asm veraendern
18308 lda #$2c:sta $9620
18309 lda #$4c:sta $986c:lda #>back:sta $986e:lda #<back:sta $986d:jmp up
18311 ; asm normalisieren
18312 l16312 lda #$a2:sta $9620
18313 lda #$20:sta $986c:lda #$9d:sta $986e:lda #$db:sta $986d
18314 ; endadresse besorgen
18315 lda $4f:sta prgend:lda $50:sta prgend+1
18316 jmp up
28600 *= $c400
28601 ; cmdtab+funtab < 128bytes, max. 51 eintraege -> bis $cc7f
28602 ; *** adressentabelle ***
28702 cmdtab .word procedure-1
28703 .word function-1
28704 .word pack-1
28705 .word memory-1
28706 .word init-1
28720 funtab .word 00
28730 ; $c480 variablenspeicher 48 bytes
28739 *=$c4b0
28750 ustab .asc "usin[199]"
28752 .asc "progra[205]"
28754 .byte 00
28798 ; **** stringtabelle ***
28800 newtab .asc "procedur[197]"
28801 .asc "functio[206]"
28802 .asc "pac[203]"
28803 .asc "memor[217]"
28804 .asc "ini[212]"
28820 funstrtab .word 00
39110 *=$304:.byte <tokenread,>tokenread
39120 *=$306:.byte <tokenlist,>tokenlist
39130 *=$308:.byte <newcmd,>newcmd
39140 *=$30a:.byte <newfun,>newfun
40500 ; ****** programmteil 2 ********
40501 ; *** nach $d400 uebertragen ***
40510 *=$7000; 28672
40511 ; adressen in prgteil1 aendern
40514 lda #<prg3a:sta startadr:lda #>prg3a:sta startadr+1
40516 lda #<prg3e:sta endadr:lda #>prg3e:sta endadr+1
40520 lda #<prg1a:sta counter:lda #>prg1a:sta counter+1
40522 lda #<prg1e:sta prgend:lda #>prg1e:sta prgend+1
40530 lda #<prg4a:sta prganf:lda #>prg4a:sta prganf+1
40535 jsr down:jsr adapt:jsr down
40600 ; prgteil3 nach destination
40602 lda #<prg3a:sta lo:lda #>prg3a:sta hi
40604 lda #<prg4a:sta lo2:lda #>prg4a:sta hi2:ldx #4:ldy #$ff:jsr transfer
40619 ; adressen in prgteil3 aendern
40624 lda #<prg3a:sta startadr:lda #>prg3a:sta startadr+1
40626 lda #<prg3e:sta endadr:lda #>prg3e:sta endadr+1
40630 lda #<prg4a:sta counter:sta prganf:lda #>prg4a:sta counter+1:sta prganf+1
40632 lda #<prg4e:sta prgend:lda #>prg4e:sta prgend+1
40645 jsr down:jsr adapt:jmp up
42001 ; *** alles runterkopieren ***
44000 ; *** programmteile sammeln ***
44001 ; *** teil2 bei $d400 ***
44004 *=$7200;29184
44030 jsr down:ldy #0:sty 2
44032 l44032 lda copytab,y:sta lo
44034 lda copytab+1,y:sta hi
44036 lda copytab+2,y:sta lo2
44038 lda copytab+3,y:sta hi2
44040 lda copytab+4,y:tax
44042 lda copytab+5,y:tay
44044 jsr transfer:lda 2:clc:adc #6:sta 2:tay:cmp #30:bne l44032
44050 ; *** teil0 anpassen ***
44054 lda #<prg0a:sta startadr:lda #>prg0a:sta startadr+1
44056 lda #<prg0e:sta endadr:lda #>prg0e:sta endadr+1
44060 lda #<mid0:sta counter:lda #>mid0:sta counter+1
44062 lda #$ff:sta prgend:lda #8:sta prgend+1
44070 lda #0:sta prganf:lda #8:sta prganf+1
44075 jsr adapt:jmp up
50000 *=$7300
50001 ; *** endprogramm ***
50002 ; *** 40 bytes $0800-0827 ***
50003 .byte 0,34,8,196,7,158,32,50
50004 .byte 48,56,56,44,51,50,55,54
50006 .byte 56,32,66,89,32,87,79,76
50008 .byte 70,71,65,78,71,32,77,65
50010 .byte 89,00,00,00,00,00,00,00
50020 ; *** programm verteilen  ab $0828 **
50025 sei:lda 1:and #248:sta 1:ldy #0:sty 2
50032 l50032 lda copytab,y:sta lo2
50034 lda copytab+1,y:sta hi2
50036 lda copytab+2,y:sta lo
50038 lda copytab+3,y:sta hi
50040 lda copytab+4,y:tax
50042 lda copytab+5,y:tay
50044 jsr transfer:lda 2:clc:adc #6:sta 2:tay:cmp #24:bne l50032
50070 ; *** vektoren setzen ***
50080 lda #<tokenread:sta $0304:lda #>tokenread:sta $0305
50082 lda #<tokenlist:sta $0306:lda #>tokenlist:sta $0307
50084 lda #<newcmd:sta $0308:lda #>newcmd:sta $0309
50086 lda #<newfun:sta $030a:lda #>newfun:sta $030b
50090 lda 1:ora #7:sta 1:cli
50095 ; ** anf.adr des procedurespeichers ablegen ***
50100 jsr ckcom:jsr $ad8a:jsr $bc9b
50101 lda $65:sta commands:sta commend:lda $64:sta commands+1:sta commend+1
50102 ; ** basic ende  $37/38 oder anf-adr proceduresp. **
50103 cmp $38:bcs l50106
50104 sta $34:sta $36:sta $38:lda $65:sta $33:sta $35:sta $37
50106 l50106 jsr $a644; new:jmp $a7ae
50200 ; *** copy routine ***
50204 transfer lda (lo),y:sta (lo2),y:dey:cpy #$ff:bne transfer
50206 inc hi:inc hi2:dex:bne transfer:rts
50300 ; *** copytab ***
50302 copytab .word $c000,$0900:.byte 4,$ff
50304 .word $d400,$0d00:.byte 4,$ff
50306 .word $c400,$1100:.byte 1,12
50308 .word $c480,$1110:.byte 1,$80
50310 .word $7300,$0800:.byte 1,$ff
50312 mid0 = $0828
59999 .end:end